perm filename BIN[GEM,BGB] blob
sn#090803 filedate 1974-03-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00023 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
C00006 00003
C00009 00004 SUBR(WITH3D,FACE,X,Y,Z) TEST FOR LOCUS WITHIN FACE 3D.
C00012 00005 SUBR(COMPFE,FACE,EDGE) COMPARE FACE EDGE 3D FOR PIERCING.
C00015 00006 SUBN(VNEXT,FACE,ALTEDG,VERTEX)
C00017 00007 SUBN(OTHERV,FACE,VERTEX) FETCH OTHER VERTEX PIERCING FACE.
C00019 00008 SUBN(BTRACE,VERTEX) TRACE THE BODY OF INTERSECTION STARTING FROM V0.
C00022 00009 SUBN(FTRACE,AFACE) FACE TRACE.
C00025 00010 SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
C00028 00011 SUBN(SOLANG,VERTEX) DIUHEDRAL ANGLE AT A PIERCING VERTEX.
C00030 00012 SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
C00033 00013 SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00035 00014 SUBR(BUN,B1,B2) BODY UNION.
C00036 00015 SUBR(MKCVEX)F MAKE CONVEX.
C00038 00016 GO L6
C00040 00017 SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00042 00018 SUBR(ESLURP,BODY) REMOVE UNNECESSARY EDGES.
C00045 00019 SUBR(MKBUCK,BODY) MAKE BUCKET CUBE.
C00047 00020 SUBR(ECUT,B,DX,DY,DZ)
C00050 00021 SUBR(BCUT,B,DX,DY,DZ)
C00055 00022 SUBN(FECUT,BODY) FACE EDGE CUTTING.
C00058 00023
C00060 ENDMK
C⊗;
TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
EXTERN VCW,VCCW,ECCW,VERIFY
EXTERN FACOEF,ESPLIT,INVERT
EXTERN GLUEE,LINKED,MKEV,MKFE
EXTERN MKB,MKF,MKV,MKFRAME
EXTERN OTHER,EVERT,FCCW,FCW
EXTERN DPYBUF,DPYSET,DPYOUT
EXTERN FDPY,EDPY,VDPY
EXTERN QFEV,KLFE,ECOEF,ECW
↓SURBIT←←1B2 ;VERTEX ON SURFACE.
↓OKBIT←←2B2
DEFINE QFACE(Q,V){CDR Q,7(V)}
DEFINE QFACE.(Q,V){DAP Q,7(V)}
DEFINE NAF (Q,E){CAR Q,-1(E)}
DEFINE NAF.(Q,E){DIP Q,-1(E)}
DEFINE PAF (Q,E){CDR Q,-1(E)}
DEFINE PAF.(Q,E){DAP Q,-1(E)}
DEFINE JALT(A,B){ALT. A,B↔ALT. B,A}
DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
MOVSI XWC(V)↔HRRI XWC(V.)↔BLT ZWC(V.)}
DECLARE{FNEXT,ENEXT}
↓PZ ←←1B28
↓NZ ←←1B29
COMMENT/
Although this code performs body union and body subtraction;
all the nomensclature will be in terms of body intersection, BIN.
Pure BIN takes two operand bodies and "copies" off them a resultant
body of their intersection. This requires marking and splitting some
of faces and edges, however the operand bodies can be restored to
their original selves by applying KLTMPS; or if the operands are no
longer needed they must be explicitly killed.
1. Face-Edge Compare; Make piercing vertices.
All the faces of each operand is compared with all the edges
of the other. When a edge passes thru a face, the edge is spilt and
a "surface vertex" or "SURV" is placed at the piercing point. The
QFACE of the SURV points at the face pierce.
2. Face Hole Suppression.
3. Body and Face Tracing.
4. Dealing with bodies of parts.
5. Convex face making.
LINKS LEFT BY BIN.
ALT of all result vertices points to a vertex in one or the
other operand. ALT of a result edge is zero, if the edge was formed
by two conflicting faces in the operands, the particular faces are
pointed at by the NAF and PAF links. A non-zero ALT of a result edge,
points at an edge of one operand that was buried inside the solid
body of the other operand, and is thus called an interior edge.
ALT of all faces of the result points at the corresponding face of
one of the operands.
/
SUBR(WITH3D,FACE,X,Y,Z) ;TEST FOR LOCUS WITHIN FACE 3D.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
LAC F,FACE
MOVM 1,AA(F)
MOVM 2,BB(F)
MOVM 3,CC(F)
MOVEI C0↔CAMG 1,2↔GO[
MOVEI C1↔CAMG 2,3↔MOVEI C2↔GO .+3]
CAMG 1,3↔MOVEI C2↔DAP CASE
;FIRST EDGE OF THE FACE.
SETOM FLG
PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,X
LAC DY2,YWC(V)↔FSB DY2,Y
LAC DZ2,ZWC(V)↔FSB DZ2,Z
L1: LAC DX1,DX2
LAC DY1,DY2
LAC DZ1,DZ2
LAC Q1,Q2
;NEXT EDGE OF THE FACE.
SETQ(V,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,X
LAC DY2,YWC(V)↔FSB DY2,Y
LAC DZ2,ZWC(V)↔FSB DZ2,Z
;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.
CASE: GO
C0: LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1: LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2: LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3: FSB 0,1↔DAC Q2
JUMPE 0,L3 ;LOCUS IS ON A FUCKING EDGE !
;DETECT SIGN CHANGE.
AOJE FLG,L2 ;JUMP ON FIRST TIME THRU.
XOR Q1↔JUMPL POP4J. ;NO SKIP RETURN FALSE.
L2: CAME E,E0↔GO L1
AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
L3: LAC DX1↔FMP DX2 ;COSINE.
LAC 1,DY1↔FMP 1,DY2↔FAD 0,1
LAC 1,DZ1↔FMP 1,DZ2↔FAD 0,1
SKIPGE↔AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
SUBR(COMPFE,FACE,EDGE) ;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
V2 ← PVT ⊗ Q2 < K ABOVE F,
| ENEW
____|_____________________
/ | /
/ ⊗ V FACE F /
/_________________________/
|
| E
V1 ← NVT ⊗ Q1 > K BELOW-F.
ACCUMULATORS{X,Y,Z,V1,V2,E,F}
;CHECK ARGUMENTS FOR FRESHNESS.
LAC E,EDGE↔LAC F,FACE
NVT V1,E↔PVT V2,E
QFACE 1,V1↔CAMN 1,F↔POP0J
QFACE 1,V2↔CAMN 1,F↔POP0J
;DIRECTED DISTANCE V1 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V1)
LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#
;DIRECTED DISTANCE V2 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V2)
LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#
;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
LAC KK(F)
CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1
;SOLVE FOR PLANE PIERCING LOCUS.
LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
CALL(WITH3D,F,X,Y,Z)↔POP0J
LAC E,EDGE↔LAC F,FACE↔ADD P,[XWD 4,4]
;MAKE FACE PIERCING POINT.
LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
CALL(ESPLIT,E)↔MARK 1,SURBIT
POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
QFACE. 0,1↔LAC 2,EDGE↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBN(VNEXT,FACE,ALTEDG,VERTEX)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E.,V}
LAC F,FACE
LAC E.,ALTEDG
LAC V,VERTEX
;INTERIOR TO INTERIOR.
ALT 1,E.↔DAC 1,ENEXT
TEST V,SURBIT↔GO[ ;SKIP WHEN VERTEX ON SURFACE.
SETQ(ENEXT,{ECCW,ENEXT,F})
CALL(VCCW,ENEXT,F)↔POP3J]
;SURFACE TO INTERIOR.
QFACE 0,V↔DAC 0,FNEXT
CAME F,FNEXT↔JUMPE 1,[
PED 1,V↔DAC 1,ENEXT
CALL(OTHER,1,V)↔POP3J]
;INTERIOR TO SURFACE.
SETZM ENEXT↔CAME F,FNEXT↔GO[
CALL(OTHERV,F,V)↔POP3J]
;SURFACE TO SURFACE.
PAF 1,E.↔CAMN 1,F↔NAF 1,E.
PED 0,V↔CALL(OTHER,0,1)↔DAC 1,FNEXT
CALL(OTHERV,FNEXT,V)↔POP3J
ENDR VNEXT;3/8/73(BGB)-----------------------------------------------
SUBN(OTHERV,FACE,VERTEX) ;FETCH OTHER VERTEX PIERCING FACE.
COMMENT ;-----------------------------------------------------------
F1 PIERCES F2 AT V2 CASE. F2 PIERCES F1 AT V2 CASE.
______________ ________
| | | |
| F2 | | F2 |
______|......... | ______|........|_____
| ↓ . | | ↓ ↓ |
| F1 ⊗V1 ⊗V2 | | F1 ⊗V1 ⊗V2 |
|_______________↑ | |_____________________|
| | | |
|______________| |________| ;
ACCUMULATORS{F1,F2,V1,E,E0}
LAC F2,FACE
LAC V1,VERTEX
QFACE F1,V1
;DOES F1 PIERCE F2 AT V2.
PED E,F1↔DAC E,E0
L1: CALL(VCCW,E,F1)
QFACE 0,1
CAMN 0,F2↔POP2J
SETQ(E,{ECCW,E,F1})
CAME E,E0↔GO L1
;DOES F2 PIERCE F1 AT V2.
PED E,F2↔DAC E,E0
L2: CALL(VCCW,E,F2)
CAMN 1,V1↔GO .+4
QFACE 0,1
CAMN 0,F1↔POP2J
SETQ(E,{ECCW,E,F2})
CAME E,E0↔GO L2
FATAL(OTHERV)
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBN(BTRACE,VERTEX) TRACE THE BODY OF INTERSECTION STARTING FROM V0.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,F.,E,E.,V,V.,V0}
SETQ(BODYIN,{MKBFV↑})↔DAC 1,B ;VERTEX BODY.
;FIRST EDGE OF THE BODY AND ALL ITS FRIENDS.
LAC V0,VERTEX↔PVT V.,B↔JALTV(V0,V.) ;MATE V0'S.
PED E,V0↔SETQ(F,{FCCW,E,V0})
PFACE F.,B↔JALT(F,F.) ;MATE F0'S.
SETQ(V,{VCCW,E,F})
LAC[XWD B,BODYIN]↔BLT VERT0 ;SAVE ACCUMULATORS.
SETQ(V.,{MKEV,F.,V.})↔DAC V.,VERT.
LAC V,VERT↔LAC E,EDGE↔JALTV(V,V.)
PED E.,V.↔DAC E.,EDGE.↔JALT(E,E.)
CAR(E)↔DIP(E.) ;MOVE TYPE BITS.
L1:
SETQ(VERT,{VNEXT,FACE,EDGE.,VERT})
CAME 1,VERT0↔GO L2
;LAST VERTEX OF THE LAMINA.
ALT 1,1↔SETQ(EDGE.,{MKFE,1,FACE.,VERT.})
LAC E.,EDGE.↔SKIPE 1,ENEXT↔GO[
JALT(1,E.)↔CAR(1)↔DIP(E.)
NFACE F.,E.↔DAC F.,FACE.↔GO L3]
LAC 1,FNEXT↔PAF. 1,E.
LAC F,FACE↔NAF. F,E.
NFACE F.,E.↔DAC F.,FACE.↔GO L3
;NEXT VERTEX OF THE LAMINA.
L2: SETQ(VERT.,{MKEV,FACE.,VERT.})
LAC V,VERT↔JALTV(V,1)
PED E.,1↔DAC E.,EDGE.
SKIPE 1,ENEXT↔GO[
JALT(1,E.)↔CAR(1)↔DIP(E.)↔GO L1]
LAC F,FACE↔PAF. F,E.
LAC 1,FNEXT↔NAF. 1,E.
GO L1
;TRACE OUT ALL THE FACES CONNECTED TO THIS BODY.
L3: CALL(EVERT,BODYIN)
L4: LAC 1,FACE.↔TEST 1,FBIT
GO[LAC 1,BODYIN↔POP1J] ;RETURN THE BODY.
CALL(FTRACE,FACE.)
LAC 1,FACE.↔PFACE 1,1↔DAC 1,FACE. ;NEXT FACE.
GO L4
DECLARE{BODYIN,FACE,FACE.,EDGE,EDGE.,VERT,VERT.,VERT0}
ENDR BTRACE;3/8/73(BGB)----------------------------------------------
SUBN(FTRACE,AFACE) FACE TRACE.
COMMENT .-----------------------------------------------------------.
;GET THE FIRST EDGE AND ITS FRIENDS.
L0: LAC 1,AFACE↔DAC 1,F.
PED 1,1↔DAC 1,E.
CALL(VCW,E.,F.)↔ALT 1,1↔DAC 1,V0
CALL(VCCW,E.,F.)↔ALT 1,1↔DAC 1,V
LAC 2,E.↔ALT 1,2↔DAC 1,E
JUMPN 1,[
CALL(OTHER,E.,F.)↔ALT 1,1
CALL(OTHER,E,1)↔GO .+5]
PAF 1,2↔PFACE 0,2
CAME 0,F.↔NAF 1,2
DAC 1,F↔LAC 2,F.↔JALT(1,2)
L1: LAC 1,V↔CAMN 1,V0↔POP1J ;EXIT.
DAC 1,U
SETQ(V,{VNEXT,F,E.,V})
SETQ(E.,{ECCW,E.,F.})
SETQ(V.,{VCCW,E.,F.})
;MAKE SPUR.
LAC 1,V↔ALT 1,1↔JUMPN 1,L2
LAC 1,U↔ALT 1,1
SETQ(V.,{MKEV,F.,1})
LAC 2,V↔JALTV(2,1)
PED 1,1↔DAC 1,E.
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔NAF. 2,1
LAC 2,F↔PAF. 2,1↔GO L1
;SPLIT FACE.
L2: CAMN 1,V.↔GO L1 ;SKIP V.≠ALT(V).
CALL(LINKED,1,F.)↔JUMPE 1,L3 ;JUMP WHEN NOT LINKED.
LAC 1,V↔ALT 1,1
LAC 2,U↔ALT 2,2
SETQ(E.,{MKFE,2,F.,1})
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔NAF. 2,1
LAC 2,F↔PAF. 2,1↔GO L1
;MAKE WASP FACE.
L3: LAC 1,V↔ALT 1,1↔DAC 1,V.
LAC 1,U↔ALT 1,1↔DAC 1,U.
LAC 1,F.↔PFACE 1,1↔DAC 1,F2.
JUMPE 1,[FATAL({WASP LINK F2.=0.})]
SETQ(E.,{GLUEE,F.,U.,F2.,V.})
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔PAF. 2,1
LAC 2,F↔NAF. 2,1↔GO L1
DECLARE{F,F.,E,E.,V,V.,U,U.,V0,F2.}
ENDR FTRACE;3/8/73(BGB)----------------------------------------------
SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
COMMENT .-----------------------------------------------------------.
L0: LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B1↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔SETZM ZPP(1)↔GO .-5
LAC 1,B2↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔SETZM ZPP(1)↔GO .-5
;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
;THIS N SQUARED PROCESS MAY SOMEDAY BE REPLACED WITH AN OCCULT MODE.
LAC 1,B2
L1: PED 1,1↔TEST 1,EBIT↔GO L2-1
LAC 2,B1↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L1
LAC 1,B1
L2: PED 1,1↔TEST 1,EBIT↔GO L3
LAC 2,B2↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L2
L3: CALL(GETSURV,B1)↔GO L4
CALL(GETSURV,B2)↔GO L4
GO L5
L4: CALL(QHOLE,1) ;CHECK OUT A POTENTIAL HOLE.
GO L3 ;NO HOLE YET.
CALL(KLSURV,B1) ;HOLE FACE WAS PYRAMID'ED.
CALL(KLSURV,B2) ;START OVER.
GO L0
L5: LAC 1,B1
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(BTRACE,1,1)
DAC 1,B#
POP P,1↔GO .-3]
LAC 1,B2
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(BTRACE,1,1)
POP P,1↔GO .-3]
LAC 1,B
POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
SUBN(SOLANG,VERTEX) DIUHEDRAL ANGLE AT A PIERCING VERTEX.
COMMENT .-----------------------------------------------------------.
EXTERN ACOS,DISTANCE,TWOPI
ACCUMULATORS{F,V}
LAC 1,VERTEX↔DAC 1,V0
PED 1,1↔DAC 1,E
SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV,F1,V0})
SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})
CALL(DISTANCE,V1,V0)↔PUSH P,1 ;L1
CALL(DISTANCE,V2,V0)↔PUSH P,1 ;L2
CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1 ;L3
;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
POP P,2↔POP P,3
LAC 2↔FMPR 3↔FSC 1
FMPR 2,2↔FMPR 3,3
FADR 1,2↔FADR 1,3
FDVR 1,0
CALL(ACOS,1)↔PUSH P,1
LAC V,V2↔LAC F,F1
LAC 0,XWC(V)↔FMPR 0,AA(F)
LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
POP P,1
CAML KK(F)↔POP1J↔MOVNS 1
FADR TWOPI↔POP1J ;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,B
L: NVT V,V↔CAMN V,B↔POP1J ;SCAN FOR...
TEST V,SURBIT↔GO L ;PIERCING VERTICES.
NVT V,V↔PUSH P,V↔PVT V,V ;SAVE NEXT...
CALL(KLEV↑,V)↔POP P,V ;KILL THIS VERTEX.
GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------
SUBN(OKSURV,VERTEX) MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,VERTEX↔PED 1,V ;FIRST EDGE.
PFACE 1,1↔DAC 1,FACE# ;FACE BELONGINF TO V.
QFACE 1,V↔DAC 1,OLDQF# ;FACE PIERCED BY V.
L: MARK V,OKBIT↔PUSH P,V
CALL(OTHERV,FACE,V) ;FOLLOW SURV LOOP ACROSS.
POP P,V
CAMN 1,VERTEX↔GO[
SETZ↔ALT2. 0,V↔POP1J] ;NIL AT END OF LIST.
ALT2. 1,V↔DAC 1,V ;OLDE V POINTS AT NEW V.
QFACE 0,V↔LAC 1,FACE ;NEXT FACE.
CAME 0,OLDQF↔LAC 1,OLDQF
DAC 0,OLDQF↔PED 0,V
SETQ(FACE,{OTHER,0,1})
GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------
SUBN(GETSURV,B) GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT .-----------------------------------------------------------.
LAC 1,B
L: NVT 1,1
CAMN 1,B↔GO[AOS(P)↔POP1J]
TEST 1,SURBIT↔GO L
TESTZ 1,OKBIT↔GO L
POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
CALL(OKSURV,VERTEX)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
LAC V,VERTEX
QFACE 1,V↔DAC 1,QF#
L1: ALT2 V,V↔JUMPE V,L2
QFACE 0,V↔CAME 0,QF↔POP1J ;EXIT NO HOLE.
GO L1
L2: SETZM A#↔SETZM N#↔SETZM X#↔SETZM Y#↔SETZM Z#
;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
LAC V,VERTEX
L3: LAC XWC(V)↔FADRM X
LAC YWC(V)↔FADRM Y
LAC ZWC(V)↔FADRM Z
AOS N↔PUSH P,V
CALL(SOLANG,V)↔FADRM 1,A
POP P,V↔ALT2 V,V
SKIPE V↔GO L3
LAC 0,N↔FLOAT↔DAC 0,N
FSBRI(2.0)↔FMPR PI↑↔FSBR A
L4: MOVMS↔CAMGE[0.01]↔POP1J ;EXIT - NO HOLE.
CALL(PYRAMID↑,QF)
LAC X↔FDVR N↔DAC XWC(1)
LAC Y↔FDVR N↔DAC YWC(1)
LAC Z↔FDVR N↔DAC ZWC(1)
PED 2,1↔DAC 2,3↔DAC 1,4
L5: MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
AOS(P)↔POP1J ;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(BUN,B1,B2) BODY UNION.
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)↔CALL(EVERT,B1)
CALL(BIN,B1,B2)
PUSHP 1↔CALL(EVERT,1) ;SAVE RESULT.
CALL(EVERT,B2)↔CALL(EVERT,B1) ;STATUS QUO ANTE.
POPP 1↔POP2J ;RETURN RESULT.
ENDR BUN;3/10/73(BGB)------------------------------------------------
SUBR(BSUB,B1,B2) BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)
CALL(BIN,B1,B2)↔PUSHP 1
CALL(EVERT,B2)↔POPP 1
POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBR(MKCVEX)F MAKE CONVEX.
COMMENT .-----------------------------------------------------------.
EXTERN MKFE,KLFE,ECOEF,VCCW,QFEV,ECW
ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}
;GET EXTREMA VERTICES.
MKCVX.:
LAC F,-1(P)↔DAC F,FACE1
TEST F,BBIT↔GO L0
L00: PFACE F,F↔CAMN F,-1(P)↔POP1J
PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0: PED E0,F↔DAC E0,EDGE0
MOVEI CNT,1
MOVSI YMAX,400000
MOVSI XMAX,400000
SETCM YMIN,YMAX
SETCM XMIN,XMAX
L1: SETQ(V,{VCCW,E0,F})
CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
SETQ(E0,{ECCW,E0,F})
CAME E0,EDGE0↔AOJA CNT,L1
;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B: CAIG CNT,3↔POP1J
GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:
LAC V,-1(P)↔DAC V,VERT2
SETQ(EDGE1,{ECCW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
SETQ(EDGE3,{ECW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
CALL(ECOEF,EDGE1)
CALL(ECOEF,EDGE3)
LAC 2,EDGE1↔LAC 3,EDGE3
LAC 1,AA(2)↔FMPR 1,AA(3)
LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
LAC 0,-1(P)
SUB P,[2(2)]↔GO @2(P) ;"POP1J"
;--------------------------------------------------------------------
L6: CALL(,N,S,E,W)
MOVSI(<-2.0>)↔DAC TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5,VERT0)
SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
MARK 1,DARKEN+NSHARP
NFACE 1,1↔DAC 1,FACE2
CALL(FACOEF↑,FACE2)
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
HRLOI 377777↔DAC QMIN↔SETZM VERT4 ;INIT FOR CLOSEST VIOLATOR.
LAC EDGE2↔DAC EDGE0 ;INIT FOR FACE1 PERIMETER SCAN.
L2: SETQ(EDGE0,{ECCW,EDGE0,FACE1})
SETQ(VERT0,{VCCW,EDGE0,FACE1})
CAMN 1,VERT1↔GO L3
;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
GO L2 ;VERTEX IS NOT WITHIN THE TRIANGLE.
;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
CALL(DISTANCE↑,VERT0,VERT2)
CAML 1,QMIN↔GO L2
DAC 1,QMIN
LAC VERT0↔DAC VERT4
GO L2 ;CONTINUE THE SCAN.
;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3: SKIPE VERT4↔GO L4
GO MKCVX.
;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4: CALL(KLFE,EDGE2)
CALL(MKFE,VERT2,FACE1,VERT4)
MARK 1,DARKEN
NFACE 1,1 ;START WORKING ON THE NEW FACE.
CALL(MKCVEX,1)
GO MKCVX. ;CONTINUE WORKING ON THE OLDE FACE.
DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL: 0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY) ;REMOVE UNNECESSARY EDGES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F1,F2,E1}
;Calculate face co-efficients for each face.
CALL(FACOEF↑,BODY)
;Go backwords thru ring of edges killing any darkened edges with
;co-planar faces.
LAC E1,BODY
LOOP: NED E1,E1
TEST E1,EBIT↔POP1J
PFACE F1,E1↔NFACE F2,E1
;Compare face co-efficients. Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
FOR @` I ε {XYZ}
< LAC I`WC(F1)↔FSBR I`WC(F2)
MOVM 0,0↔CAML 0,[0.000001]↔GO LOOP
> LAC 0,E1
;They're co-planar, now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
MARK E1,DARKEN
PVT 1,E1↔DAC 1,V1
NVT 1,E1↔DAC 1,V2
;Do PVT
NCCW 1,E1↔SETQ V3,{OTHER↑,1,V1}
PCW 1,E1 ↔SETQ V4,{OTHER↑,1,V1}
PUSH P,E1
CALL(ANGL3V↑,V3,V1,V2) ;ANGL3V appears to return a value < π
MOVEM 1,T1 ;so both angles must be summed, instead
CALL(ANGL3V↑,V2,V1,V4) ;of just angle between CW and CCW edges.
FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;Do NVT
PCCW 1,E1↔SETQ V3,{OTHER↑,1,V2}
NCW 1,E1 ↔SETQ V4,{OTHER↑,1,V2}
PUSH P,E1
CALL(ANGL3V↑,V3,V2,V1)↔DAC 1,T1
CALL(ANGL3V↑,V1,V2,V4)↔FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;We found an unneeded edge, kill it!
NED 0,E1
PUSH P,0↔CALL(KLFE↑,E1)↔POP P,E1
GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
SUBR(MKBUCK,BODY) ;MAKE BUCKET CUBE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}
;FIND COORDINATE EXTREMA.
HRLOI XLO,377777↔HRLZI 400000
HRLOI YLO,377777↔HRLZI 400000
HRLOI ZLO,377777↔HRLZI 400000
LAC B,BODY↔LAC V,B
L1: PVT V,V↔CAMN V,B↔GO L2
CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
GO L1
;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2: PUSH P,[0]
DAC XHI,0↔FSBR XHI,XLO↔FADR XLO,0↔FSC XLO,-1↔PUSH P,XLO
DAC YHI,0↔FSBR YHI,YLO↔FADR YLO,0↔FSC YLO,-1↔PUSH P,YLO
DAC ZHI,0↔FSBR ZHI,ZLO↔FADR ZLO,0↔FSC ZLO,-1↔PUSH P,ZLO
CALL(MKCUBE↑,XHI,YHI,ZHI)
DAC 1,BUCK#↔DAC 1,-3(P) ;PLACE BUCKET IN PDL.
CALL(TRANSLATE↑);"B,XLO,YLO,ZLO)" ;POSITION THE BUCKET.
LAC 1,BUCK↔POP1J
ENDR MKBUCK;1/15/74(BGB)---------------------------------------------
DECLARE{ZCUT,LIST1,FSET1,ELIST1,ELIST2,BSET1}
SUBR(ECUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETOM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR ECUT;3/6/74(BGB)------------------------------------------------
SUBR(FCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETZM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR FCUT;3/6/74(BGB)------------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
;CLEAR THE NZ AND PZ BITS OF ALL THE VERTICES.
SETZM PZCNT↔SETZM NZCNT
MOVEI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
;MARK THE VERTICES AS EITHER ABOVE OR BELOW ZERO XWC.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
SKIPGE XWC(V)↔GO L2
MARK V,PZ↔AOS PZCNT↔GO L1 ;POSITIVE.
L2: MARK V,NZ↔AOS NZCNT↔GO L1 ;NEGATIVE.
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT,CUTFLG,FRM}
SUBR(BCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2
MOVEI 1↔DAC CUTFLG↔CALL(FECUT,B) ;BODY CUT +1.
L1: SKIPN 2,ELIST2↔GO[
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)↔POP4J]
ALT2 1,2↔DAC 1,ELIST2↔DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L2: SKIPN 2,ELIST1↔GO[
LAC 1,FACE1↔LAC 2,FACE2 ;LINK TWO NEW FACES.
MARK 1,TMPBIT↔MARK 2,TMPBIT
ALT. 1,2↔ALT. 2,1
LAC 1,FACE1↔PED 1,1↔CCW 1,1↔CAME 1,B↔GO[CALL(BATT↑,1,B)↔GO $.+1]
LAC 2,FACE2↔PED 2,2↔CCW 2,2↔CAME 2,B↔GO[CALL(BATT↑,2,B)↔GO $.+1]
GO L1]
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})
GO L2
DECLARE{EDGE,FACE1,FACE2}
ENDR BCUT;3/6/74(BGB)------------------------------------------------
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
PVT V1,1↔NVT V2,1 ;GET VERTICES.
LAC(V1)↔EQV(V2)
TESTZ(,PZ+NZ)↔GO L0 ;TEST FOR EDGE CROSSING.
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
SETOM FLAG ;FIRST TIME THRU FLAG -1.
SETZM LIST1↔LAC 1,EDGE ;LIST OF VERY SHORT EDGES.
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E
NVT V1,1↔PVT V2,1
PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[
CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})
MARK 1,TMPBIT
MARK 1,PZ↔PED 1,1
SKIPLE CUTFLG↔GO[
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1
SETQ(UU2,{ESPLIT,ELIST1})
MARK 1,TMPBIT
MARK 1,NZ↔GO .+1]
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
MOVN 0,XWC(V1)↔FDVR 0,DX↔LAC 2,U2
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[
LAC U2↔DAC U0
LAC UU2↔DAC UU0
GO L2]
;SPLIT FACES.
SKIPL CUTFLG↔GO[
CALL(MKFE,U2,F,U1)
MARK 1,TMPBIT
NFACE 1,1
SKIPE CUTFLG↔GO[
CALL(MKFE,UU2,1,UU1)
MARK 1,TMPBIT
GO .+1]↔GO .+1]
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1
LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
CALL(VCCW,E,F)
TEST 1,NZ↔GO L3
GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: SKIPGE CUTFLG↔GO L0
CALL(MKFE,U0,F,U1)
MARK 1,TMPBIT
NFACE 1,1
SKIPG CUTFLG↔GO L0
CALL(MKFE,UU0,1,UU1)
MARK 1,TMPBIT
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1
DAC 1,ELIST2
GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
END